package clstatdb;

use Fcntl ':flock';
use DBI;
use Carp qw(cluck);

#########################################################################
# Class level variables to record errors of last call.			#
#########################################################################

my $cldb_errcode=0;
my $cldb_errstr=undef;

#########################################################################
# Records is an array of known record types with details of each field	#
# including whether it is optional or not, and what kind of validation	#
# and manipulation to apply when attempting to add records via the	#
# add_verified_record method.						#
#########################################################################

my %records=(
	"node_status" => {
		"node"		=> ["m",\&is_unique],
		"update_time"	=> ["m",\&is_integer]
		},

#	"ports"	=> {
#		"number"	=> ["m",\&is_unique,\&is_integer,\&is_nowhitespace],
#		"type"		=> ["m"],
#		"detail"	=> ["o"],
#		},
#	"topology" => {
#		"name"		=> ["m",\&is_unique,\&is_nowhitespace],
#		"lcards"	=> ["o"],
#		"pcards"	=> ["o"],
#		"type"		=> ["m",\&is_valid_nettype]
#		},
#	"applications" => {
#		"name"		=> ["m",\&is_unique_app_in_cluster],
#		"prefnode"	=> ["m",\&is_valid_app_preference],
#		"nodes"		=> ["m",\&is_valid_node_list],
#		"consistency"	=> ["m",\&is_valid_failover_type],
#		"startscript"	=> ["o",\&is_valid_script],
#		"stopscript"	=> ["o",\&is_valid_script],
#		"starttimeout"	=> ["o",\&is_integer],
#		"stoptimeout"	=> ["o",\&is_integer],
#		"checksum"	=> ["m",\&is_sha1],
#		},
#	"application_ips" => {
#		"name"		=> ["m",],
#		"network"	=> ["m",],
#		"ips"		=> ["m",],
#		"netmask"	=> ["o",\&is_netmask],
#		"broadcast"	=> ["o",\&is_ip_addr],
#		"version"	=> ["o",\&is_4_or_6],
#		},
#	"application_fs" => {
#		"name"		=> ["m",\&is_cluster_app],
#		"mountpnt"	=> ["m"],
#		"options"	=> ["o"],
#		"fstype"	=> ["m",\&is_supported_fs],
#		"vg"		=> ["m",\&is_existing_vg,\&is_unique_in_cluster],
#		"lv"		=> ["m",\&is_existing_lv],
#		"size"		=> ["m",\&is_integer],
#	},
#	"locks" => {
#		"name"		=> ["m",\&is_unique,\&is_nowhitespace],
#		"type"		=> ["m",\&is_host_or_cluster],
#		"desc"		=> ["m"],
#		"maxtime"	=> ["m",\&is_integer],
#		"maxkeepers"	=> ["m",\&is_integer],
#	}
);

my %records_postadd=(
);

{
my $dd=0;
my $debugmode=0;

sub _dprint {
	if(time-$dd > 60) {
		if(-f "$::ENV{TRUECL_CODE}/flags/clstatdb.debug") {
			$debugmode=1;
		} else {
			$debugmode=0;
		}
		$dd=time;
	}
	if($debugmode) {
		if(-f "$::ENV{TRUECL_CODE}/flags/clstatdb.debug") {
			my $fd;
			open($fd,">>$::ENV{TRUECL_CODE}/log/clstat-debug.log");
			print $fd @_;
			close($fd);
		}
	}
}

}

sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self  = {};
my $dbname=$_[0];

	if(!defined($dbname)) {
		$dbname="/etc/cluster/status.db";
	}
	my $stime=time;
	my $ctime=0;
	_dprint("$$: Attempting to gain exclusive lock.\n");
	$self->{LOCK}=undef;

	if(defined($::DO_STATDB_LOCKING) && $::DO_STATDB_LOCKING==1) {
		while(1) {
			my $fd;
			if(!open($fd,">>$dbname.lck")) {
				$cldb_errcode=1;
				$cldb_errstr="Unable to open lockfile $dbname.lck";
				return undef;
			}
			if(! flock($fd,LOCK_EX|LOCK_NB)) {
				select(undef,undef,undef,0.1);
				$ctime+=.1;
				last if $ctime>5;
			} else {
				$self->{LOCK}=$fd;
				last;
			}
		}
		if(!defined($self->{LOCK})) {
			::warning("clstatdb: Unable to get lock - attempting with out it!");
		} else {
			_dprint("$$: Lock granted!\n");
			if ($ctime>=2) {
				::warning("clstatdb: Waited $ctime seconds to get database lock.") if(defined(&::warning));
			}
		}
	}
	$cldb_errcode=0;
	$cldb_errstr=undef;
	$self->{DBH}=DBI->connect("dbi:SQLite:dbname=$dbname","","",
			{RaiseError => 0,PrintError => 0,AutoCommit => 1});
	if(!defined($self->{DBH})) {
		$cldb_errcode=1;
		$cldb_errstr="Unable to connect to database $dbname!.";
		return undef;
	}
	$self->{FILENAME}=$dbname;
	bless($self,$class);
	_dprint("$$: Opened database.\n");
	return $self;
}

#########################################################################
# Class method to return the latest error (code,string), 		#
# or undef if last call was successful.					#
#########################################################################

sub error {
	return($cldb_errcode,$cldb_errstr);
}

#########################################################################
# Instance method to execute any old SQL against the current database.	#
#########################################################################

sub do($$;$) {
my $self=shift;
my $timeout=$_[2];

	_dprint("$$: Attempting '$_[0]'\n");
	$timeout=3 if !defined($timeout);
	$cldb_errcode=0;
	$cldb_errstr=undef;
	my $ctime=0;
	$timeout=99; #SE
	while($ctime<=$timeout) {
		my $rc=$self->{DBH}->do($_[0]);
		if(defined($rc) && $rc==1) {
			_dprint("$$: Successful!\n");
			return 1;
		}
		if($self->{DBH}->err()) {
			if(defined(&::logit)) {
				::logit("clstatdb: Error code   is " . $self->{DBH}->err());
				::logit("clstatdb: Error string is " . $self->{DBH}->errstr());
			}
			if(defined(&::warning)) {
				::warning("clstatdb: Error code   is " . $self->{DBH}->err());
				::warning("clstatdb: Error string is " . $self->{DBH}->errstr());
			}
			cluck("clstatdb: Error code   is ",$self->{DBH}->err());
			print STDERR "clstatdb: Error string is ",$self->{DBH}->errstr(),"\n";
			
			if($self->{DBH}->err()==5) {
				$cldb_errcode=5;
				$cldb_errstr=$self->{DBH}->errstr;
				$ctime+=0.10;
				select(undef,undef,undef,0.10);
				next;
			}
			$rc=$self->{DBH}->errstr();
			if(defined($rc)) {
				$cldb_errcode=2;
				$cldb_errstr=$rc;
				_dprint("$$: Error: $rc\n");
				return 0;
			}
		}
		_dprint("$$: Completed successfully.\n");
		return 1;
	}
	_printf("$$: Failed - timeout.\n");
	return 0;
}

# Does nothing, since autocommit is now turned on

sub commit($) {
my $self=shift;

	$cldb_errcode=0;
	$cldb_errstr=undef;
}

sub disconnect {
my $self=shift;

	_dprint("$$: Disconnect called.\n");
	if(defined($self->{DBH})) {
		$self->{DBH}->disconnect;
		flock($self->{LOCK},LOCK_UN) if defined($self->{LOCK});
		$self->{DBH}=undef;
	}
}

sub DESTROY {
my $self=shift;

	if(defined($self->{DBH})) {
		$self->{DBH}->disconnect;
	}
	$self->{DBH}=undef;
	_dprint("$$: Closed database.\n");
}

sub exists($$$) {
my $self=shift;
my ($type,$obj)=@_;
my ($cmd,$rc,$sth);

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$type="table" if !defined($type);
	$cmd="SELECT * FROM SQLITE_MASTER WHERE type = '$type' AND name = '$obj';";
	$sth=$self->{DBH}->prepare($cmd);
	if(!defined($sth)) {
		$rc=$self->{DBH}->errstr;
		$cldb_errcode=4;
		$cldb_errstr=$rc;
		return 0;
	}
	$sth->execute();
	if(!defined($sth->fetchrow_hashref)) {
		return 0;
	}
	return 1;
}

sub get_rows($$) {
my ($self,$query)=@_;
my ($sth,$rc,@R,$aref);

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$sth=$self->{DBH}->prepare($query);
	if(!defined($sth)) {
		$rc=$self->{DBH}->errstr;
		$cldb_errcode=5;
		$cldb_errstr=$rc;
		return undef;
	}
	$sth->execute();
	@R=();
	while($aref  = $sth->fetchrow_hashref) {
		push @R,{%$aref};
	}
	return \@R;
}

sub get_object_schema($$$) {
my ($self,$type,$obj)=@_;
my ($cmd,$aref,$sth,$rc);

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$type="table" if !defined($type);
	if(!defined($obj)) {
		$cldb_errcode=6;
		$cldb_errstr="Specified object value is undefined.";
		return undef;
	}
	$cmd="SELECT * FROM SQLITE_MASTER WHERE type = '$type' AND name = '$obj';";
	$sth=$self->{DBH}->prepare($cmd);
	if(!defined($sth)) {
		$rc=$self->{DBH}->errstr;
		$cldb_errcode=7;
		$cldb_errstr=$rc;
		return undef;
	}
	$sth->execute();
	if(!defined($aref=$sth->fetchrow_hashref)) {
		$cldb_errcode=8;
		$cldb_errstr="$obj of type $type does not exist.";
		return undef;
	}
	return $aref->{sql};
}

sub get_record_requirements {
my ($crec,$str);

	$str="";
	for $crec (sort(keys %records)) {
		$str.=sprintf("  * %-20s ::= ",$crec);
		my $ckey;
		for $ckey (keys(%{$records{$crec}})) {
			if($records{$crec}->{$ckey}->[0] eq "m") {
				$str.="$ckey ";
			}
		}
		for $ckey (keys(%{$records{$crec}})) {
			if($records{$crec}->{$ckey}->[0] eq "o") {
				$str.="[$ckey] ";
			}
		}
		$str.="\n";
	}
	return $str;
}

sub add_verified_record {
my $self=shift;
my $ARG_table=shift;
my @ARGV=@_;
local $DBH;		# For use in verifiation sub-routines
my %VALUES=();

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$DBH=$self->{DBH};

	my ($code,$val,$rc,$str);
	if(!exists($records{$ARG_table})) {
			$cldb_errcode=10;
			$cldb_errstr="Add_validated_record does not work on table '$ARG_table'.";
			return 0;
	}

	my %had=();
	foreach (@ARGV) {
		my $carg=$_;
		my ($field,$value)=split(/:/,$carg);
		$had{$field}=$value;
	}

	foreach (@ARGV) {
		my $carg=$_;
		my ($field,$value)=split(/:/,$carg);

		if(!exists($records{$ARG_table}->{$field})) {
			$cldb_errcode=10;
			$cldb_errstr="Column '$field' is not defined in table '$ARG_table'.";
			return 0;
		}

		#################################################################
		# If the field has one or more validation, formation tools,	#
		# then call it now.						#
		#################################################################

		for $code ((@{$records{$ARG_table}->{$field}})[1..9]) {
			next if !defined($code);
			next if $code eq "";
			($rc,$val)=&$code($ARG_table,$field,$value,\%had);
			if($rc) {
				$cldb_errcode=11;
				$cldb_errstr="$val";
				return 0;
			}
			$value=$val if defined($val);
		}
		$VALUES{$field}=$value;
	}

	#################################################################
	# Check to ensure that all mandatory fields have been specified	#
	# and if not then the process should abort with suitable error.	#
	#################################################################

	my @B=();
	my $ckey;
	for $ckey (keys(%{$records{$ARG_table}})) {
		if($records{$ARG_table}->{$ckey}->[0] eq "m" &&
			!exists($VALUES{$ckey})) {
			push @B,$ckey;
		}
	}
	if(@B) {
		$cldb_errcode=11;
		$cldb_errstr="Mandatory columns missing for new row on table '$ARG_table': ".join(",",@B);
		return 0;
	}

	#################################################################
	# Everything should now be in place to actually add the		#
	# record.							#
	#################################################################
	
	my $cmd="INSERT INTO $ARG_table(";
	$cmd.=join(",",(keys %VALUES));
	$cmd.=") VALUES(";
	my @L=map { "'$_'"; } (values %VALUES);
	$cmd.=join(",",@L) . ");";

	$DBH->do("BEGIN TRANSACTION");
	$DBH->do($cmd);
	$rc=$DBH->errstr;
	if(defined($rc)) {
		$cldb_errcode=12;
		$cldb_errstr="Error occured whilst performing:\n$cmd\n\nError: $rc\n";
		$DBH->do("ROLLBACK TRANSACTION");
		return 0;
	} else {
		if(exists($::records_postadd{$ARG_table})) {
			($rc,$str)=&{$::records_postadd{$ARG_table}}($self,$ARG_table,%VALUES);
			if($rc) {
				$cldb_errcode=12;
				$cldb_errstr="Error occured whilst performing post add update:\n$str";
				$DBH->do("ROLLBACK TRANSACTION");
				return 0;
			}
		}
	}
	$DBH->do("END TRANSACTION");
	$DBH->commit;
	return 1;
}

#########################################################################
# Below are verification methods that should not be used directly -	#
# they are called via the add_verified_record.				#
#########################################################################

sub is_unique($$$$) {
my ($table,$field,$value,$ref)=@_;
my ($sth,$cmd,$rc);

	$cmd="SELECT * FROM $table WHERE $field = '$value';";
	$sth=$DBH->prepare($cmd);
	if(!defined($sth)) {
		$rc=$DBH->errstr;
		return(1,"Error attempting to query table $table:\n$rc");
	}
	if(! $sth->execute()) {
		return(1,"Unable to execute '$cmd':\n".$DBH->errstr);
	}
	if(defined($sth->fetchrow_hashref)) {
		return(1,"Value '$value' already exists in column '$field' in table '$table'.");
	}
	return(0,undef);
}

sub is_nowhitespace($$$$) {
my ($table,$field,$value,$ref)=@_;

	cluck("here!");
	if($value =~ /\s+/) {
		return(1,"Value '$value' for column '$field' must not contain white space.");
	}
	return(0,undef);
}

sub is_mailid($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^[\w\-\.]+@([\w\-]+\.{0,1}){1,4}$/i &&
		$value =~ /[^\.]+$/) {
		return(0,undef);
	}
	return(1,"Value '$value' is not a valid Internet email address.");
}

sub encode_key($$$$) {
my ($table,$field,$value,$ref)=@_;

	my $ctx=Digest::SHA1->new;
	$ctx->add($value);
	my $hex=$ctx->hexdigest;
	return(0,$hex);
}

sub is_unixname($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^[\w\-]+$/) {
		return(0,undef);
	}
	return(1,"Value '$value' is not a valid UNIX filename.");
}

sub is_yesno($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^(y|yes|n|no)$/i) {
		return(0,uc(substr($value,0,1)));
	}
	return(1,"Value '$value' is not valid for a 'yes/no' column.");
}

sub is_valid_date($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ m{^\d{2}/\d{2}/\d{4}$}) {
		return(0,undef);
	}
	return(1,"Date must be in format 'DD/MM/YYYY'");
}

sub is_integer($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^\d+$/) {
		return(0,undef);
	}
	return(1,"Value '$value' is not a valid integer.");
}

sub is_number($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^\d+$/ || $value =~ /\d*\.\d+$/) {
		return(0,undef);
	}
	return(1,"Value '$value' is not a valid number.");
}

sub is_valid_nettype($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^failover$/i) {
		return(0,lc($value));
	}
	return(1,"Value '$value' is not a valid network type.");
}

sub is_known_cluster($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_known_cluster not yet implemented.");
}

sub is_unique_app_in_cluster($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_unique_app_in_cluster not yet implemented.");
}

sub is_valid_failover_type($$$$) {
my ($table,$field,$value,$ref)=@_;

	if($value =~ /^normal|force$/i) {
		return(0,lc($value));
	}
	return(1,"Value '$value' is not a valid failover type.");
}

sub is_sha1($$$$) {
my ($table,$field,$value,$ref)=@_;
	if($value =~ /^[a-f0-9]{40}$/i) {
		return(0,lc($value));
	}
	return(1,"Value '$value' is not a valid SHA1 hex value.");
}

#########################################################################
# App preference can be blank, LEAST_LOAD or a name of a node.		#
#########################################################################

sub is_valid_app_preference($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_valid_app_preference not yet implemented.");
}

sub is_valid_script($$$$) {
my ($table,$field,$value,$ref)=@_;

	if(! -e "$value") {
		return(2,"Script '$value' not found locally.");
	}
	return(0,undef);
}

sub is_netmask($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_valid_app_preference not yet implemented.");
}

sub is_ip_addr($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_valid_app_preference not yet implemented.");
}

sub is_4_or_6($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_valid_app_preference not yet implemented.");
}

sub is_cluster_app($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_cluster_app not yet implemented.");
}

sub is_supported_fs($$$$) {
my ($table,$field,$value,$ref)=@_;
my @FS=qw{ext2 ext3 xfs jfs reiserfs};

	if(scalar(grep {/^$value$/i} @FS)) {
		return(0,lc($value));
	}
	return(2,"File system type '$value' has not been validated against Linuxha.net V2!");
}

sub is_existing_vg($$$$) {
my ($table,$field,$value,$ref)=@_;

	die("Routine is_existing_vg not yet implemented.");
}

sub is_unique_in_cluster($$$$) {
my ($table,$field,$value,$ref)=@_;

	# Is the VG not in use on this node for any other app/cluster
	# Does the VG exist at all.
	die("Routine is_unique_in_cluster not yet implemented.");
}

sub is_existing_lv($$$$) {
my ($table,$field,$value,$ref)=@_;

	# Does the VG/LV exist locally?
	# Does the LV_meta exist and is 128Mb in size?
	die("Routine is_existing_lv not yet implemented.");
}

sub is_host_or_cluster($$$$) {
my ($table,$field,$value,$ref)=@_;
my @FS=qw{host cluster};

	if(scalar(grep {/^$value$/i} @FS)) {
		return(0,lc($value));
	}
	return(1,"Lock type '$value' is unknown.");
}

#########################################################################
# If the specified table is known, but does not yet exist, then create	#
# it as necessary.							#
#########################################################################

sub create_if_needed($$) {
my $self=shift;
my $ARG_table=shift;
my %T=(
	"topology_status"	=> "CREATE TABLE topology_status(topology VARCHAR(50),failcount INTEGER, lastfailtime CHAR(20), nextreset INTEGER, card CHAR(20), status INTEGER, alive INTEGER);",
	"app_route_status"	=> "CREATE TABLE app_route_status(label VARCHAR(50),appname VARCHAR(50),failcount INTEGER, lastfailtime CHAR(20), nextreset INTEGER, status INTEGER, alive INTEGER);",
	"restart_apps"		=> "CREATE TABLE restart_apps(appname VARCHAR(50),failnode VARCHAR(50), failtime INTEGER);",
	"modded_settings"	=> "CREATE TABLE modded_settings(appname VARCHAR(50),attrname VARCHAR(50), value VARCHAR(255));",
	"app_status"		=> "CREATE TABLE app_status(name VARCHAR(50) PRIMARY KEY,host VARCHAR(50), status VARCHAR(20), starttime INTEGER, updatetime INTEGER, valid VARCHAR(200));",
	"app_registered"	=> "CREATE TABLE app_registered(name VARCHAR(50) PRIMARY KEY, date INTEGER );",
	"cluster_status_vars"	=> "CREATE TABLE cluster_status_vars(var VARCHAR(50) PRIMARY KEY, value VARCHAR(200) );",
	"data_sync"		=> "CREATE TABLE data_sync(appname VARCHAR(50), lvname VARCHAR(50), vgname VARCHAR(50), updatetime INTEGER, status CHAR(10), storage_spec VARCHAR(50), attempts INTEGER, req_syncrate INTEGER, act_syncrate INTEGER);",
	"app_ips"		=> "CREATE TABLE app_ips(appname VARCHAR(50), network VARCHAR(50), ind INTEGER, ip  VARCHAR(20), updatetime INTEGER, type CHAR(2), netmask VARCHAR(20), broadcast VARCHAR(20));",
	"diskhb"		=> "CREATE TABLE diskhb(diskhb VARCHAR(50), status VARCHAR(50));",
	"mond_status"	=> "CREATE TABLE mond_status(type CHAR(1), appname VARCHAR(50),monname VARCHAR(50), montype VARCHAR(50), status INTEGER, interval INTEGER, failcount INTEGER, lastfailtime INTEGER, wakeup INTEGER, rearm INTEGER, pid INTEGER);"
	);

	if(!exists($T{$ARG_table})) {
		return 0;
	}
	if(!clstatdb::exists($self,"table",$ARG_table)) {
		my $r=clstatdb::do($self,$T{$ARG_table});
		if(!$r) {
			return 0;
		}
			clstatdb::commit($self);
	}
	return 1;
}

1;

